---
title: "Assessment of Social Vulnerability and Child Opportunity before COVID19"
output:
flexdashboard::flex_dashboard:
storyboard: true
source: embed
---
```{r setup, include=FALSE, cache=TRUE}
# Load packages
library(dplyr) # data manipulation
library(reshape) # data manipulation
library(tidyverse) # data manipulation
library(DescTools) # data manipulation
library(tigris) # geospatial data
library(sp) # visualization
library(htmlwidgets) # visualization
library(leaflet) # visualization
library(ggplot2) # visualization
library(flexdashboard) # visualization
library(ggpubr) # visualization
schools <- readRDS(file = "rds_files/schools.rds")
merge_opp <- readRDS(file = "rds_files/merge_opp.rds")
nyc_covid <- readRDS(file = "rds_files/nyc_covid.rds")
nyc_zips <- readRDS(file = "rds_files/nyc_zips.rds")
county_sp <- readRDS(file = "rds_files/county_sp.rds")
svi_tracts <- readRDS(file = "rds_files/svi_tracts.rds")
ds_svi <- readRDS(file = "rds_files/ds_svi.rds")
```
### Interactive Leaflet Test of SVI, COI, COVID, and Geo boundaries
```{r, cache=TRUE}
# Layer 1 - COVID by ZIP options
popup1 <- paste0("Zip Code: ", nyc_covid$ZCTA5CE10, "
", "Percent Positive Cases: ", nyc_covid$zcta_cum.perc_pos)
pal1 <- colorNumeric(palette = "YlGnBu", domain= nyc_covid$zcta_cum.perc_pos)
# Layer 2 - SVI by Census Tract options
popup2 <- paste0("GEOID: ", svi_tracts$GEOID, "
", "Social Vulnerability Index: ", svi_tracts$RPL_THEMES,"
", "COUNTY: ", svi_tracts$COUNTY)
pal2 <- colorFactor(palette = "YlGnBu", domain = svi_tracts$cat)
# Layer 3 - Child Opportunity Index
popup3 <- paste0("GEOID: ", merge_opp$GEOID, "
", "Child Opportunity Level: ", merge_opp$c5_COI_nat,"
", "COUNTY: ", merge_opp$msaname15)
pal3 <- colorFactor(palette = "YlGnBu", domain = merge_opp$c5_COI_nat, reverse = TRUE)
# Layer 4 - SMH Layer
popup4 <- paste0("School Name: ", schools$location_name, "
","DBN: ", schools$system_code, "
","Address: ", schools$primary_address_line_1)
# Label Text
labels1 <- sprintf( # label for covid by zip code
"Zip code: %s
Perc. Positive: %g",
nyc_covid$ZCTA5CE10, nyc_covid$zcta_cum.perc_pos
) %>% lapply(htmltools::HTML)
labels2 <- sprintf( # label for zip codes
"Zip code: %s",
nyc_zips$ZCTA5CE10) %>% lapply(htmltools::HTML)
labels3 <- sprintf( # label for county names
"County: %s",
county_sp$NAME) %>% lapply(htmltools::HTML)
labels4 <- sprintf( # label for school names
"School Name: %s",
schools$location_name) %>% lapply(htmltools::HTML)
# label parameters
label_Options <- labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"), textsize = "15px", direction = "auto")
# highlight parameters
highlight_Options <- highlightOptions(color = "white", weight = 2, fillOpacity = 0.9, bringToFront = TRUE)
highlight_Options2 <- highlightOptions(color = "white", weight = 2, bringToFront = TRUE)
p <- leaflet() %>%
# Base Groups
addProviderTiles("CartoDB.Positron", group = "Positron") %>%
addTiles(urlTemplate = "http://mt0.google.com/vt/lyrs=m&hl=en&x={x}&y={y}&z={z}&s=Ga",
attribution = 'Google', group = "Google Map") %>%
addTiles(group = "default") %>%
addProviderTiles(providers$Stamen.TonerLite, group = "Toner Lite") %>%
# Overlay Groups
addCircleMarkers(data=schools, # school layer
lat = schools$latitude,
lng = schools$longitude,
weight = 2,
radius = 2,
stroke = FALSE,
fillOpacity = 1.0,
label = labels4,
popup = popup4,
group = "NYC Schools") %>%
addPolygons(data = nyc_covid, # NYC ZIPS + COVID19 % Positive
fillColor = ~pal1(zcta_cum.perc_pos),
weight =2,
color = "black",
fillOpacity = 0.7,
popup = popup1,
label = labels1,
labelOptions = label_Options,
highlightOptions = highlight_Options,
group = "COVID19 % Positive") %>%
addPolygons(data = svi_tracts, # SVI by Census Tracts
fillColor = ~pal2(cat),
color = "black",
fillOpacity = 0.7,
weight = 1,
smoothFactor = 0.2,
popup = popup2,
highlightOptions = highlight_Options,
group = "Social Vulnerability Index") %>%
addPolygons(data = merge_opp, # Child Opportunity Index by Census Tracts
fillColor = ~pal3(c5_COI_nat),
color = "#b2aeae",
fillOpacity = 0.5,
weight = 1,
smoothFactor = 0.2,
popup = popup3,
highlightOptions = highlight_Options,
group = "Child Opportunity Index") %>%
addPolygons(data = nyc_zips, # NYC Zip Codes
weight =2,
color= "black",
fillOpacity = 0,
label = labels2,
labelOptions = label_Options,
highlightOptions = highlight_Options2,
group = "zips") %>%
addPolygons(data = county_sp, # NY County Boundaries
color = "black",
fillOpacity = 0,
weight = 2,
label = labels3,
labelOptions = label_Options,
highlightOptions = highlight_Options2,
group = "county") %>%
setView(lng = "-73.935242", lat = "40.730610", zoom = 10) %>%
# Layers control
addLayersControl(
baseGroups = c("Positron","Google Map", "default", "Toner Lite"),
overlayGroups = c("NYC Schools", "COVID19 % Positive", "Social Vulnerability Index", "Child Opportunity Index", "zips", "county"),
options = layersControlOptions(collapsed = FALSE)
) %>%
addLegend(pal = pal1,
values = nyc_covid$zcta_cum.perc_pos,
position = "bottomleft",
title = "Percent Positive",
labFormat = labelFormat(suffix = "%"),
group = "COVID19 % Positive") %>%
addLegend(pal = pal2,
values = svi_tracts$cat,
position = "bottomright",
title = "Social Vulnerability Index",
group = "Social Vulnerability Index") %>%
addLegend(pal = pal3,
values = merge_opp$c5_COI_nat,
position = "topright",
title = "Child Opp",
group = "Child Opportunity Index") %>%
hideGroup(c("COVID19 % Positive", "Child Opportunity Index", "zips", "county", "NYC Schools" ))
p
```
***
This is a test display of an interactive leaflet in a flexdashboard. The leaflet contains NYC specific data on Social Vulnerability, Child Opportunity, and County/Census/Zip geographic boundaries.
- Positron, default, and Toner lite are different choices of basemap.
- COVID, SVI, and COI layers are best viewed one at a time. The overlay of these layers will need to be thought through.
- The zips layer can be used with the SVI and COI layers to get a sense of zip boundaries.
- The county layer can be used with any to get a sense of county boundaries.
### Scatter plot of Social Vulnerability percentile ranks of each Census Tract by County
```{r, echo=FALSE}
ds_svi %>%
ggplot(aes(x=LOCATION, y=RPL_THEMES)) +
geom_point(alpha=0.5) +
facet_grid(~ COUNTY)
```
***
The following is a scatter plot of Social Vulnerability by Census Tract by County. Alpha reduced to show overlap/density. From the clustering of points, we can see that majority of the census tracts within the Bronx County are ranked high in social vulnerability, tracts in Kings and Queens county show relatively the same story, but with a greater level of distribution in social vulnerability, tracts in New York and Richmond counties are relatively dispersed.
### Stacked bar chart of the proportion of Social Vulnerability categories
```{r, echo=FALSE}
datm <- ds_svi %>% # number of tracts in SVI cats by county
group_by(COUNTY, cat) %>%
summarize(count=n()) %>%
cast(COUNTY ~ cat) %>% # reshape for plotting
mutate(Counties = factor(COUNTY)) %>%
gather(variable, value, -Counties) %>%
slice(6:n())
datm$variable <- ordered(datm$variable, levels = c("Lowest Vulnerability", "Low Medium Vulnerability", "High Medium Vulnerability", "Highest Vulnerability")) # order factor for plotting
datm %>% # stacked bar chart
mutate(value=as.numeric(value)) %>%
ggplot(aes(x = Counties,
y = value,
fill = forcats::fct_rev(variable))) +
geom_bar(position = "fill",stat = "identity") +
scale_y_continuous(labels = scales::percent_format())
```
***
The following is a stacked bar chart of the proportion of each of the SVI categories by County. This shows the same story as the scatter plot but in proportions .
### Stacked bar chart of the proportion of Child Opportunity categories
```{r}
merge_opp@data %>%
select(countyfips, c5_COI_nat) %>%
group_by(countyfips, c5_COI_nat) %>%
summarize(n=n()) %>%
cast(countyfips ~ c5_COI_nat) %>% # reshape for plotting
mutate(Counties = factor(countyfips)) %>%
gather(variable, value, -Counties) %>%
slice(6:n()) %>%
mutate(value=as.numeric(value)) %>%
ggplot(aes(x = Counties,# stacked bar chart
y = value,
fill = forcats::fct_rev(variable))) +
geom_bar(position = "fill",stat = "identity") +
scale_y_continuous(labels = scales::percent_format())
```
***
The following is a stacked bar chart of the proportion of each of the child opportunity categories. Will need to adjust county fips to names
```{r, eval=FALSE}
# merge svi and coi
svi_opp <- left_join(svi_tracts@data, merge_opp@data, by="GEOID")
# assess svi and coi relationship
svi_opp %>%
select(cat, c5_COI_nat) %>%
count(cat, c5_COI_nat) %>%
ggplot(aes(x = cat, y = c5_COI_nat)) +
geom_point(alpha = 0.7, aes(size = n))
```
```{r, eval=FALSE}
# identify schools in high impact regions through census tract
# convert borough to cnty code
schools$STCNY[substr(schools$system_code, 3, 3) == "K"] <- "36047" # Kings
schools$STCNY[substr(schools$system_code, 3, 3) == "X"] <- "36005" # Bronx
schools$STCNY[substr(schools$system_code, 3, 3) == "Q"] <- "36081" # Queens
schools$STCNY[substr(schools$system_code, 3, 3) == "M"] <- "36061" # New York
schools$STCNY[substr(schools$system_code, 3, 3) == "R"] <- "36085" # Richmond
# clean census tract var in schools
schools$census_tract <- sub("[.]", "", schools$census_tract)
# use str as sub for NA in corresponding census tract value
svi_tracts$LOCATION <- str_replace_all(svi_tracts$LOCATION, fixed(" "), "")
svi_opp$x <- substr(svi_tracts$LOCATION, 12, (StrPos(svi_tracts$LOCATION, ","))-1)
svi_opp$NAME.y <- ifelse(is.na(svi_opp$NAME.y), svi_opp$x, svi_opp$NAME.y)
svi_opp$NAME.y <- sub("[.]", "", svi_opp$NAME.y) # remove "." in svi_opp's abv tract
schools %>% select(system_code, community_district, borough_block_lot, ctny_cname) %>% arrange(ctny_cname)
svi_opp %>% group_by(ctny_cname) %>% filter(n()>1)
#school_tracts <- left_join(schools, svi_opp, by)
```
